--- This is an undocumented module
module tests.qc.Parser where

import Data.MicroParsec hiding (label)
import Test.QuickCheck as Q public 

-- ------------------------------------------------ Parser properties

ascii = fmap chr (Q.choose (ord ' ', 126))
inputs = Q.listOf ascii
parsers :: Q.Gen (String, Parser [] Char Char) 
parsers = Q.elements [
    ("match no char", satisfy (const false)),   -- fail
    ("match any char", pany),  
    ("match even char", satisfy (even . ord)),   -- fail 50%
    ("letter", letter), 
    ("digit", digit), 
    ("space", space), 
    -- ("eos", eos >> return (chr 0)),
    ("letter letter", letter >> letter), 
    ("digit letter", digit >> letter), 
    ("letter any letter", letter >> pany >> letter)
    ]
-- avoid deriving Show for Parser
allParsers prop = parsers >>= (\(s,x) ->
    Q.printTestCase s (prop x))

--- p always succeeds
succeeds p = Q.forAll inputs (
    either (const false) (const true) . fst . runid p)

--- p always fails
fails p = Q.forAll inputs (
    either (const true) (const false) . fst . runid p)

--- p and q are the same parsers    
same p q = Q.forAll inputs (\xs ->
    Parser.run p xs == Parser.run q xs)

--- p succeeds if and only if q succeeds
agree p q = Q.forAll inputs (\xs ->
        case fst (runid p xs) of
          Left   _ -> either (const true) (const false) (fst . runid q $ xs)
          Right  _ -> either (const false) (const true) (fst . runid q $ xs)
    )
    
--- p succeeds if and only if q fails
disagree p q = Q.forAll inputs (\xs ->
        case fst (runid p xs) of
          Right _ -> either (const true) (const false) (fst . runid q $ xs)
          Left  _ -> either (const false) (const true) (fst . runid q $ xs)
    )

--- p and q consume the same input
consumeTheSame p q = Q.forAll inputs (\xs ->
    snd (runid p xs) 
        ==  snd (runid q xs)) 

--- p consumes no input on failure
consumesNotOnFailure p = Q.forAll inputs (\xs ->
    case runid p xs of
        (Left _, ts)   -> Q.label "parser failed" (ts == xs)
        (Right _, _)   -> Q.label "parser success" true
    )


--- 'return' _a_ always succeeds
prop_return = succeeds (return 'a')

--- 'pzero' fails
prop_pzero_1 = fails pzero

--- 'pzero' consumes not
prop_pzero_2 = consumesNotOnFailure pzero

--- 'failure' fails
prop_failure = fails (failure "x")

--- @any@ and @eos@ disagree
prop_any_eos = pany `disagree` eos

--- 'optional' always succeeds
prop_optional = allParsers (\p -> succeeds (optional p))

--- 'option' always succeeds
prop_option = allParsers (\p -> succeeds (option 'a' p))

--- 'many' always succeeds
prop_many = allParsers (\p -> succeeds (many p))

--- 'skip' always succeeds
prop_skip = allParsers (\p -> succeeds (skip p))

--- 'many' and 'skip' consume the same amount of tokens
prop_skip_many_consume_the_same = allParsers (\p ->
    skip p `consumeTheSame` many p)

--- 'many' and 'skip' agree
prop_skip_many_agree = allParsers (\p ->
    skip p `agree` many p)

--- 'satisfy' and 'exceptWhen' disagree
prop_sat_except = satisfy (even . ord) `disagree` exceptWhen (even . ord)
    
--- 'skip' is 'many' followed by return ()
prop_skip_fast_many = allParsers (\p ->
    skip p `same` (many p >> return ()))

--- > p <|> pzero
--- consumes nothing on failure of _p_
prop_alt_pzero_no_consume = allParsers (\p ->
    consumesNotOnFailure (p <|> pzero))

--- @p@ and @p <|> pzero@ agree
prop_p_agrees_p_or_pzero = allParsers (\p ->
    p `agree` (p <|> pzero))

--- @pzero <|> p@ is the same as @p@
prop_p_or_zero_same_p = allParsers (\p ->
    (pzero <|> p) `same` p)

--- @choice []@ is the same as @pzero@    
prop_choice_0 = (choice [] `asTypeOf` pany) `same` (pzero::Parser [] Char Char)

--- @choice [p]@ is the same as @p@    
prop_choice_1 = allParsers (\p ->
    choice [p] `same` p)

--- @choice [p,q]@ is the same as @p <|> q@    
prop_choice_2 = allParsers (\p ->
    allParsers (\q ->
    choice [p,q] `same` (p <|> q)))

--- @count 0@ is the same as @return []@
prop_count_0 = allParsers (\p ->
    count 0 p `same` return [])

--- @count 0@ is the same as @p@
prop_count_1 = allParsers (\p ->
    count 1 p `same` fmap return p)

